home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / sound / compraw.zip / COMPRAW.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-08  |  11KB  |  368 lines
  1. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}{$M 49152,0,0}
  2. Program CompRaw(Output);
  3. {
  4.     Raw Sound Lossy [De]compression Program  Version 1.00
  5.     Copyright (c) 1992 François Jalbert (jalbert@IRO.UMontreal.CA)
  6.  
  7.     Turbo-Pascal 5.0 (c) 1988 Borland International
  8.     LZEXE 0.91 (c) 1989 Fabrice Bellard
  9.  
  10.     Error Levels: 0 - Normal termination.
  11.                   1 - Command line parameter error.
  12.                   2 - I/O error.
  13. }
  14. Const
  15.   MaxBufferSize=32768; { Multiple of 8 }
  16.  
  17. Type
  18.   BufferRange=1..MaxBufferSize;
  19.   BufferRange0=0..MaxBufferSize;
  20.   BufferType=Record
  21.                BufferItself:Array [BufferRange] of Byte;
  22.                BufferSize:BufferRange0
  23.                End;
  24.   HandleType=Record
  25.                HandleName:String;
  26.                HandleFile:File
  27.              End;
  28.  
  29. Var 
  30.   Compress:Boolean;              {[De]compression Flag (True or False)}
  31.   Rate:Byte;                     {[De]compression Rate (1 to 7)}
  32.   Buffer:BufferType;             {I/O Buffer}
  33.   InHandle,OutHandle:HandleType; {Input and Output File Handles}
  34.  
  35. {------------------------------- ReadParameters -------------------------------}
  36.  
  37. Procedure Ooops(Var Error:Boolean; Message:String);
  38. {Set error flag and print error message}
  39. Begin
  40. Error:=True;
  41. Writeln(^G+'Error: '+Message)
  42. End;
  43.  
  44. Procedure ReadOperation(Var Compress,CompSet:Boolean; Var Rate:Byte; 
  45.                         Var RateSet,Error:Boolean; Var Param:String; 
  46.                         ParamLength:Integer);
  47. {Sets one operation parameter according to one command line parameter}
  48. Begin
  49. If ParamLength<>2 Then
  50.   Ooops(Error,'Parameter too long: '+Param)
  51. Else
  52.   Case Param[2] Of
  53.     'd','D':If CompSet Then 
  54.               Ooops(Error,'Unexpected parameter: '+Param)
  55.             Else
  56.               Begin
  57.               CompSet:=True;
  58.               Compress:=False;
  59.               Writeln('Decompression operation.')
  60.               End;
  61.     'c','C':If CompSet Then 
  62.               Ooops(Error,'Unexpected parameter: '+Param)
  63.             Else
  64.               Begin
  65.               CompSet:=True;
  66.               Compress:=True;
  67.               Writeln('Compression operation.')
  68.               End;
  69.     '1'..'7':If RateSet Then 
  70.                Ooops(Error,'Unexpected parameter: '+Param)
  71.              Else
  72.                Begin
  73.                RateSet:=True;
  74.                Rate:=Ord(Param[2])-Ord('0');
  75.                Writeln('Rate is 8 to '+Param[2]+'.')
  76.                End
  77.     Else
  78.       Ooops(Error,'Unrecognized parameter: '+Param)
  79.     End
  80. End;
  81.  
  82. Procedure ReadHandleName(Var InSet,OutSet,Error:Boolean; Var Param:String;
  83.                          Var InHandle,OutHandle:HandleType);
  84. {Sets one file handle according to one command line parameter}
  85. Begin
  86. If InSet Then
  87.   If OutSet Then
  88.     Ooops(Error,'Unexpected parameter: '+Param)
  89.   Else
  90.     Begin
  91.     OutSet:=True;
  92.     OutHandle.HandleName:=Param;
  93.     Writeln('Output file name: '+OutHandle.HandleName+'.')
  94.     End
  95. Else
  96.   Begin
  97.   InSet:=True;
  98.   InHandle.HandleName:=Param;
  99.   Writeln('Input file name: '+InHandle.HandleName+'.')
  100.   End
  101. End;
  102.  
  103. Procedure ReadParameters(Var Compress:Boolean; Var Rate:Byte;
  104.                          Var InHandle,OutHandle:HandleType);
  105. {Sets all parameters according to command line parameters}
  106. Var 
  107.   InSet,OutSet,CompSet,RateSet,Error:Boolean;
  108.   Param:String;
  109.   ParamIndex,ParamLength:Word;
  110. Begin
  111. InSet:=False;
  112. OutSet:=False;
  113. CompSet:=False;
  114. RateSet:=False;
  115. If ParamCount=0 Then 
  116.   Error:=True
  117. Else
  118.   Begin
  119.   Error:=False;
  120.   For ParamIndex:=1 To ParamCount Do
  121.     Begin;
  122.     Param:=ParamStr(ParamIndex);
  123.     ParamLength:=Length(Param);
  124.     If (Param[1]='/') OR (Param[1]='-') Then
  125.       ReadOperation(Compress,CompSet,Rate,RateSet,Error,Param,ParamLength)
  126.     Else
  127.       ReadHandleName(InSet,OutSet,Error,Param,InHandle,OutHandle)
  128.     End;
  129.   If NOT InSet Then 
  130.     Ooops(Error,'Input file name not specified on command line');
  131.   If NOT OutSet Then 
  132.     Ooops(Error,'Output file name not specified on command line');
  133.   If NOT CompSet Then
  134.     Ooops(Error,'Operation type not specified on command line');
  135.   If NOT RateSet Then
  136.     Ooops(Error,'Rate not specified on command line')
  137.   End;
  138. If Error Then 
  139.   Begin
  140.   If ParamCount>0 Then Writeln;
  141.   Writeln('Syntax is COMPRAW <infile> <outfile> /<rate> < /c | /d >');
  142.   Halt(1)
  143.   End
  144. End;
  145.  
  146. {----------------------------------- Files ------------------------------------}
  147.  
  148. Procedure CheckError(Message:String);
  149. {In case of I/O error, prints message and aborts program}
  150. Begin
  151. If IOResult<>0 Then
  152.   Begin
  153.   Writeln;
  154.   Writeln(^G+'Error: '+Message);
  155.   Halt(2)
  156.   End
  157. End;
  158.  
  159. Procedure OpenHandles(Var InHandle,OutHandle:HandleType);
  160. {Opens input and output file handles}
  161. Begin
  162. With InHandle Do
  163.   Begin
  164.   Assign(HandleFile,HandleName);
  165.   CheckError('Can''t assign input file to its name');
  166.   FileMode:=0;
  167.   Reset(HandleFile,1);
  168.   CheckError('Can''t open input file')
  169.   End;
  170. With OutHandle Do
  171.   Begin
  172.   Assign(HandleFile,HandleName);
  173.   CheckError('Can''t assign output file to its name');
  174.   FileMode:=1;
  175.   Rewrite(HandleFile,1);
  176.   CheckError('Can''t create output file')
  177.   End
  178. End;
  179.  
  180. Procedure ReadBuffer(Var InHandle:HandleType; Var Buffer:BufferType);
  181. {Reads as many bytes as possible into the buffer}
  182. Var Result:Word;
  183. Begin
  184. With InHandle,Buffer Do 
  185.   Begin
  186.   BlockRead(HandleFile,BufferItself,MaxBufferSize,Result);
  187.   CheckError('Can''t read input file');
  188.   BufferSize:=Result
  189.   End
  190. End;
  191.  
  192. Procedure WriteBuffer(Var OutHandle:HandleType; Var Buffer:BufferType);
  193. {Writes the buffer}
  194. Var Result:Word;
  195. Begin
  196. With OutHandle,Buffer Do 
  197.   Begin
  198.   BlockWrite(HandleFile,BufferItself,BufferSize,Result);
  199.   CheckError('Can''t write output file');
  200.   If Result<BufferSize Then
  201.     Begin
  202.     Writeln;
  203.     Writeln(^G+'Error: Disk full');
  204.     Halt(2)
  205.     End
  206.   End
  207. End;
  208.  
  209. Procedure CloseHandles(Var InHandle,OutHandle:HandleType);
  210. {Closes input and output file handles}
  211. Begin
  212. Close(InHandle.HandleFile);
  213. CheckError('Can''t close input file');
  214. Close(OutHandle.HandleFile);
  215. CheckError('Can''t close output file')
  216. End;
  217.  
  218. {-------------------------------- Compression ---------------------------------}
  219.  
  220. Procedure Compression(Var Buffer:BufferType; Rate:Byte);
  221. {Performs compression of bytes in the buffer}
  222. Var 
  223.   Index:Word;
  224.   Data,Offset,Mask,Limit:Byte;
  225. Begin
  226. Offset:=$80 SHR Rate;
  227. Mask:=$FF SHL (8-Rate);
  228. Limit:=Mask+Offset-1;
  229. With Buffer Do
  230.   For Index:=1 To BufferSize Do
  231.     Begin
  232.     Data:=BufferItself[Index];
  233.     {Shifts according to simple log 2 table}
  234.     Case Data Of
  235.       $C0..$FF:Data:=$E0+( (Data-$C0) SHR 1 );
  236.       $A0..$BF:Data:=$C0+(Data-$A0);
  237.       $80..$99:Data:=$80+( (Data-$80) SHL 1 );
  238.       $60..$7F:Data:=$80-( ($80-Data) SHL 1 );
  239.       $40..$5F:Data:=$40-($60-Data);
  240.       $00..$3F:Data:=$20-( ($40-Data) SHR 1 )
  241.       End;
  242.     If Data>Limit Then 
  243.       {Avoids overflow}
  244.       BufferItself[Index]:=Mask
  245.     Else 
  246.       {Centers byte and zeros out the least significant bits}
  247.       BufferItself[Index]:=(Data+Offset) AND Mask
  248.     End
  249. End;
  250.  
  251. {------------------------------- Decompression --------------------------------}
  252.  
  253. Procedure Decompression(Var Buffer:BufferType; Rate:Byte);
  254. {Performs decompression of bytes in the buffer}
  255. Var 
  256.   BeginIndex,EndIndex,Number,Index,BeginSide,EndSide:Word;
  257.   Offset,Data:Byte;
  258.   LOffset,LOffset1,LNumber1:LongInt;
  259.   BOffset2,Identical,BeginHigher,EndHigher:Boolean;
  260. Begin
  261. {Sets centering related data}
  262. Offset:=$80 SHR Rate;
  263. LOffset:=LongInt(Offset);
  264. LOffset1:=LongInt(Offset-1);
  265. BOffset2:=(Offset>2);
  266. With Buffer Do
  267.   Begin
  268.   EndIndex:=BufferSize;
  269.   Repeat
  270.     {Sets begin data, when possible}
  271.     BeginIndex:=EndIndex;
  272.     If BeginIndex<BufferSize Then 
  273.       BeginHigher:=NOT EndHigher;
  274.     {Sets end data, when possible}
  275.     Data:=BufferItself[BeginIndex];
  276.     Identical:=True;
  277.     While (EndIndex>0) AND Identical Do
  278.       If BufferItself[EndIndex]<>Data Then
  279.         Identical:=False
  280.       Else 
  281.         EndIndex:=EndIndex-1;
  282.     If EndIndex>0 Then
  283.       EndHigher:=(BufferItself[EndIndex]>Data);
  284.     {Finds the l